home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / BBS / PROKIT34.ARJ / TOOLS.INT < prev    next >
Text File  |  1991-04-01  |  8KB  |  250 lines
  1.  
  2. (*
  3.  * Copyright 1987, 1989 Samuel H. Smith;  All rights reserved
  4.  *
  5.  * This is a component of the ProDoor System.
  6.  * Do not distribute modified versions without my permission.
  7.  * Do not remove or alter this notice or any other copyright notice.
  8.  * If you use this in your own program you must distribute source code.
  9.  * Do not use any of this in a commercial product.
  10.  *
  11.  *)
  12.  
  13. (*
  14.  * Top level unit for the Tool Shop Tools Library
  15.  *
  16.  *)
  17.  
  18. unit Tools;
  19.  
  20. interface
  21.  
  22.    uses Dos, MDosIO, debugs;
  23.  
  24. const
  25.    namesizes = 50;      {size of filenames}
  26.  
  27. type
  28.    filenames  = string[namesizes];
  29.    anystring  = string[128];
  30.    longstring = string[255];
  31.  
  32.    string2   = string[2];
  33.    string4   = string[4];
  34.    string5   = string[5];
  35.    string6   = string[6];
  36.    string8   = string[8];
  37.    string10  = string[10];
  38.    string12  = string[12];
  39.    string13  = string[13];
  40.    string20  = string[20];
  41.    string25  = string[25];
  42.    string30  = string[30];
  43.    string40  = string[40];
  44.    string65  = string[65];
  45.    string72  = string[72];
  46.    string80  = string[80];
  47.    string160 = string[160];
  48.    string240 = string[240];
  49.    string255 = string[255];
  50.  
  51.    char2  = array[1..2] of char;
  52.    char3  = array[1..3] of char;
  53.    char4  = array[1..4] of char;
  54.    char5  = array[1..5] of char;
  55.    char6  = array[1..6] of char;
  56.    char7  = array[1..7] of char;
  57.    char8  = array[1..8] of char;
  58.    char9  = array[1..9] of char;
  59.    char10 = array[1..10] of char;
  60.    char11 = array[1..11] of char;
  61.    char12 = array[1..12] of char;
  62.    char13 = array[1..13] of char;
  63.    char14 = array[1..14] of char;
  64.    char15 = array[1..15] of char;
  65.    char16 = array[1..16] of char;
  66.    char19 = array[1..19] of char;
  67.    char24 = array[1..24] of char;
  68.    char25 = array[1..25] of char;
  69.    char30 = array[1..30] of char;
  70.    char39 = array[1..39] of char;
  71.    char40 = array[1..40] of char;
  72.    char32 = array[1..32] of char;
  73.    char35 = array[1..35] of char;
  74.    char45 = array[1..45] of char;
  75.    char128 = array[1..128] of char;
  76.  
  77. procedure determine_tasker;     {determine what multi-tasker is active, if any}
  78. procedure give_up_time;         {give up unused time under doubledos}
  79.  
  80. const
  81.    tasker:  (taskview,                  {taskview/omniview/topview/desqview}
  82.              doubledos,                 {doubledos}
  83.              notasker,                  {single task}
  84.              unknown) = unknown;        {before first call}
  85.  
  86. function ftoa(f: real; width,dec: integer): string20;
  87. function atof (asc:           anystring): real;
  88. function atoi (asc:  anystring): integer;
  89. function atol (asc:  anystring): longint;
  90. function atow (asc:  anystring): word;
  91. function insert_commas(s: anystring): anystring;
  92. function itoa (int: integer): string8;
  93. function ltoa (int: longint): string8;
  94. function wtoa (w: word): string8;
  95.  
  96. type
  97.   single    = array[0..3] of byte;
  98. function stof(B: single): real;
  99.    {convert 4 byte single to real}
  100. procedure ftos(PasReal: real; var B: single);
  101.    {convert real to 4 byte single}
  102. function stol(s: single): longint;
  103. procedure incs(var s: single; n: real);
  104. procedure ltos(l: longint; var B: single);
  105. procedure zeros(var B: single);
  106.  
  107. type
  108.   double    = array[0..7] of byte;
  109.  
  110. function dtof(B: double): real;
  111.    {convert 8 byte double to real}
  112. function dtol(B: double): longint;
  113.    {convert 8 byte double to long integer}
  114. procedure ftod(PasReal: real; var B: double);
  115.    {convert real to 8 byte double}
  116. procedure incd(var d: double; n: real);
  117.  
  118. function stoa(s: single): string10;
  119.  
  120. function dtoa(d: double): string10;
  121. function itoh(i: longint): string8;   {integer to hex conversion}
  122. function htoi(h: string8): longint;   {hex to integer conversion}
  123.  
  124. function i_to_ur(i: integer): real;  {integer to unsigned-real conversion}
  125. function ur_to_i(v: real): integer;  {unsigned-real to integer conversion}
  126.  
  127. type
  128.    long_int = record
  129.       case integer of
  130.          1: (b: array[1..4] of byte);
  131.          2: (lsw: integer;
  132.              msw: integer);
  133.    end;
  134.  
  135. function ltor(long: long_int): real;
  136. procedure rtol(r: real;
  137.                var long: long_int);
  138.  
  139. function remove_path(name: filenames): filenames;
  140. function path_only(name: filenames): filenames;
  141. function name_only(name: filenames): filenames;
  142. function remove_ext(name: filenames): filenames;
  143. function ext_only(name: filenames): filenames;
  144. procedure cons_path(var path: filenames;
  145.                     dir,name: filenames);
  146. procedure cons_name(var resu:          filenames;
  147.                     name1,name2,ext:   filenames);
  148.  
  149. function is_wild(filename: anystring): boolean;
  150. procedure stoupper(var st: string);
  151. function upstring(st: string): string;
  152.  
  153. procedure stolower(var st: string);
  154. procedure capstr(var s: string);
  155. function file_size(name: string65): longint;
  156. function wildcard_match (var pattern,
  157.                          line:               string65): boolean;
  158. {pattern must be upper case; line is not case sensitive}
  159. function strval (i: integer): string2;
  160. function system_dd: string2;
  161. function system_mm: string2;
  162. function system_yy: string2;
  163. function system_date: string8;   {format: mm-dd-yy}
  164. function system_time: string8;   {format: hh:mm}
  165. function get_time: real;
  166. function lget_time: longint;
  167. function lget_ms: longint;
  168. function get_mins: integer;
  169. procedure delay(ms: longint);
  170.    (* delay a specified number of miliseconds; give up time while delaying *)
  171. procedure delete_spaces(var line: string);
  172. procedure delete_trailing_spaces(var line: string);
  173. procedure delete_leading_spaces(var line: string);
  174. procedure replace_string( var line: string; oldstr, newstr: anystring);
  175.    (* perform string replacement if possible *)
  176. function get_environment_var(id: string20): anystring;
  177. function environment_on(id: string20): boolean;
  178.  
  179. type
  180.    varstring = ^string;
  181.  
  182. procedure releasestr( var str:  varstring);
  183.    (* release the memory used by a varstring variable.  variable MUST
  184.       be pre-allocated or the program may crash!!! *)
  185.  
  186. procedure savestr( var tostr: varstring;
  187.                    from:      string);
  188.    (* save a regular string in a varstring; new allocation of varstring *)
  189.  
  190. const
  191.    maxnumfiles =  200;
  192.    null =         #0;
  193. type
  194.    filearray =    array [1.. maxnumfiles] of varstring;
  195. var
  196.    filetable:     filearray;
  197.    filecount:     integer;
  198.  
  199. procedure getfiles (pattern:       string65;
  200.                     var fdir:      filearray;
  201.                     var num:       integer);
  202.  
  203. function ljust(s: string80; w: integer): string80;
  204. function rjust(s: string80; w: integer): string80;
  205.  
  206. const
  207.    maxbit = 10000;
  208. type
  209.    bitnumber = 0..maxbit-1;
  210.    bitmap = record
  211.       bits:  array[0..4] of byte;       {bits 0..39}
  212.    end;
  213.  
  214. function getbit(var bmap{: bitmap}; bitnum: bitnumber): boolean;
  215.    {return true/false for specified bit 0..39 in a bitmap}
  216.  
  217. procedure setbit(var bmap{: bitmap}; bitnum: bitnumber; value: boolean);
  218.    {set the specified bit in a bitmap}
  219.  
  220. function getflag(flag: byte; bitval: byte): boolean;
  221.    {return true/false for specified is set}
  222. procedure setflag(var flag: byte; bitval: byte; value: boolean);
  223.    {set the specified bit in a flagbyte}
  224. function toggleflag(var flag: byte; bitval: byte): boolean;
  225.    {toggle the specified bit and return new setting}
  226.  
  227. procedure vappends(var line: varstring; s: anystring);
  228.  
  229. function disk_space(disk: char): longint;
  230.    {report space on drive in k bytes}
  231.  
  232. procedure qWrite(x,y: integer; s: string);
  233.  
  234. procedure backup_file(name: anystring);
  235.  
  236. type
  237.   BTable = array[#0..#255] of byte;
  238.  
  239. procedure MakeTable(var SrchSt : string;
  240.                     var cray : BTable);
  241.  
  242. function BMsearch(var buffr;
  243.             bsize : Integer;
  244.             var table;
  245.             var SrchSt : string) : integer;
  246.  
  247.    function cpos(c: char; var s): integer;
  248.  
  249. implementation
  250.